(* Esther Kundin & Ayla Brayer
   This program has all of the functions that convert from the objects in Ast to the objects in Astc *)
open Ast
open Astc

(************** Global environment - reference will be set in main func ****)
let globalEnv = ref {Astc.variable_types = StringMap.empty;
                     Astc.variable_values = StringMap.empty;
                     Astc.response_type = "string";
                     Astc.response_value = "garbage" }


(*let get_variable_type var =
   if ((String.compare var "response") == 0) then globalEnv.contents.response_type else
     (try StringMap.find var globalEnv.contents.variable_types
      with Not_found -> raise (Failure ("undeclared variable " ^ var))) *)
(********************************************************************)


(******** error / type checking functions ****************)

(* 
function get_vbl_type - returns variable type (as string)
param var - variable name (string)
param t   - type of the in scope response variable, 
               if called outside a question "out_of_scope" is expected
*)
let get_vbl_type var t = 
   if ((String.compare var "response") == 0) then
	  if ((String.compare t "out_of_scope") == 0) then
	      raise (Failure ("Accessing 'response' out of scope")) 
	  else 
	      t 
   else (* raise exception if the variable was not found *)
      (try StringMap.find var globalEnv.contents.variable_types with Not_found 
	   -> raise (Failure ("undeclared variable " ^ var)))


(*
function get_expression_type - returns the type of a given expressions while
         checking the validity of the expression 
param e - Ast.exprn
param t - type of the in scope response variable, 
		  if called outside a question "out_of_scope" is expected
*)
let rec get_expression_type e t = match e with 
    Literal(i) ->"int"
   |Bool(s) -> "bool"
   |Float(s) ->"float"
   |Id(id) -> let rt = get_vbl_type id t in rt
   |Noexpr -> raise (Failure ("missing expression"))
   |Str(s) ->"string"
   |Exprn(e) ->  let rt = get_expression_type e t in rt
   |IntNegation (i) -> "int"
   |FloatNegation (f) -> "float" 
   |IdNegation (id) -> (* negation is only valid on int or float type *)
      let tp = get_vbl_type id t in 
	  if ((String.compare tp "float") == 0 || 
	      (String.compare tp "int") == 0) then
	     tp
      else
         raise (Failure ("illigal negation (allowed only on int or float type)"))
    |Assign (id,e2) -> 
	   if ((String.compare id "response") == 0) then 
          raise (Failure ("illigal assignemt to 'response' variable"))
	   else 
          let rhs = get_vbl_type id t in 
          let lhs = get_expression_type e2 t in 
          if ((String.compare rhs lhs) == 0) then 
	         rhs 
          else 
             raise (Failure ("illigal " ^ rhs ^ " to " ^ lhs ^ " assignemt"))
	|Binop (e1, o, e2) -> 
	   let rhs = get_expression_type e1 t in 
       let lhs = get_expression_type e2 t in match o with
	      (* mathematical operators *)
	      Ast.Add | Ast.Mult | Ast.Sub | Ast.Div -> 
          (*for the above operations to be legal, sub-expr must be of same type*) 
		     if ((String.compare rhs lhs) == 0) then 
			 (* the above operations are not legal on strings & booleans *) 
			    if (((String.compare rhs "string") == 0 || 
                     (String.compare rhs "bool") == 0 )) then
				   raise (Failure ("illigal operation preformed on " ^ rhs))
                else
                   rhs
             else 
                raise (Failure ("illigal " ^ "rhs" ^ " on " ^ "lhs" ^ " operation"))
		  (* comparison operators *)
		  |Ast.Less | Ast.Leq | Ast.Greater | Ast.Geq -> 
		  (*for the above operations to be legal, sub-expr must be of same type*)
             if ((String.compare rhs lhs) == 0) then 
                (* the above operations are not legal on strings & booleans *) 
			    if (((String.compare rhs "string") == 0 || 
                     (String.compare rhs "bool") == 0 )) then
                   raise (Failure ("illigal operation preformed on " ^ rhs))
                else
                   "bool" (* return bool *)
			 else 
                raise (Failure ("illigal " ^ "rhs" ^ " on " ^ "lhs" ^ " operation"))				
		   |Ast.Equal | Ast.Neq -> (*expressions must be of same type*) 
              if ((String.compare rhs lhs) == 0) then 
			     rhs
              else 
				 raise (Failure ("" ^ rhs ^ " cannot be comapred with " ^ lhs))
		   (* logical operators *)
		   |Ast.And | Ast.Or -> 
		      (*logical operators cannot be applied on strings*)
		      if (((String.compare rhs "string") == 0 || 
				   (String.compare lhs "string") == 0 )) then 
                 raise (Failure ("&&/|| applied to type string"))
			  else
				 "bool" (* return type of logical expressions is bool *) 
			    



(* 
function - check_answer_expression
  The answer expression may evaluate to a boolean, 
  int or float but not a string. Also checks that the 
  expression is in accordance with the type rules
param t - type of the in scope response variable, 
		  if called outside a question "out_of_scope" is expected
param a  - Ast.answer
*)
let rec check_answer_expression t = function
   (expn, ab) -> match expn with 
      Literal(i) -> t (* stand alone int is ok *)
      |Bool(s) ->  t  (* stand alone bool is ok *)
      |Float(s) -> t  (* stand alone float is ok *)
      |Id(id) -> let tp = get_vbl_type id t in 
         if ((String.compare tp "string") == 0) then 
		    raise (Failure ("string type is not allowed in answer expression"))
		 else
			t
	  |Exprn(e) -> let rt = get_expression_type e t in 
         if ((String.compare rt "string") == 0) then 
            raise (Failure ("string type is not allowed as answer expression"))
		 else
			t
      |Noexpr -> raise (Failure ("missing answer-expression")) (*this will fail in the parsing part*)
      |Str(s) -> raise (Failure ("string is not allowed as an answer expression")) 
      |Assign(id, ex) -> let tp = get_expression_type ex t in 
         if ((String.compare tp "string") == 0) then 
            raise (Failure ("string type is not allowed as answer expression"))
         else 
            tp
      |Binop (e1, o, e2) -> let tp = get_expression_type expn t in tp
      |IntNegation (i) -> t 
      |FloatNegation (f) -> t 
      |IdNegation (id) -> let tp = get_vbl_type id t in
         if ((String.compare tp "float") == 0 || (String.compare tp "int") == 0) then
		    tp
         else
            raise (Failure ("illigal negation (allowed only on int or float type)")) 


(*
function - check_types - check validity of the answer's expressions
param t - type of the in scope response variable, 
		  if called outside a question "out_of_scope" is expected
param answerlist - Ast.answer_list
*)
let check_types = function
    (t, answerlist) -> ignore (List.fold_left check_answer_expression t answerlist)
	 
	 
	 
	 
	 
(************ Main conversion functions that convert from ast to astc ******)





(*
function cop_of_op - Ast to Astc conversion
*)
let cop_of_op = function
    Ast.Add -> Astc.Add
  | Ast.Sub -> Astc.Sub
  | Ast.Mult -> Astc.Mult
  | Ast.Div -> Astc.Div
  | Ast.Equal -> Astc.Equal
  | Ast.Neq -> Astc.Neq
  | Ast.Less -> Astc.Less
  | Ast.Leq -> Astc.Leq
  | Ast.Greater -> Astc.Greater
  | Ast.Geq -> Astc.Geq
  | Ast.And -> Astc.And
  | Ast.Or -> Astc.Or


(*
function cexpr_of_expr - converts expresions to Astc type
*)
let rec cexpr_of_expr = function
    Literal(i) -> Astc.CLiteral (string_of_int i) 
  | Id(s) -> Astc.CVar (s)
  | Str(s) -> Astc.CStr(s)
  | Float(s) -> Astc.CLiteral(string_of_float s)
  | Bool (s) -> Astc.CLiteral(string_of_bool(s))  
  (*For assignments, need to make sure that we're not assigning to response*)
  | Assign (id, e) -> 
	   Astc.CAssign(id, (cexpr_of_expr e))
  | Binop (e1, o, e2) -> 
	   Astc.CBincop (cexpr_of_expr e1, cop_of_op o, cexpr_of_expr e2) 
  | IntNegation (i)   -> Astc.CNegate (string_of_int i)
  | FloatNegation (f) -> Astc.CNegate (string_of_float f)
  | IdNegation (id)   -> Astc.CNegateId id
  | Exprn(e) -> cexpr_of_expr(e)
  | Noexpr -> Astc.CNoexpr 


(*
function validate_statements - make sure 
    expressions are error free
param sl - Ast.statement_list
param t  - type of the in scope response variable, 
		  if called outside a question "out_of_scope" is expected 

*)
let rec validate_statements sl t = match sl with
    [] ->  ""
    | hd::tl -> match hd with 
                   Ast.Print(s) -> validate_statements tl t
				   |Ast.Expr (e) -> ignore (get_expression_type e t); 
		                            validate_statements tl t


(* function cstmt_of_statement - convert statement to cstatement *)
let cstmt_of_statement = function
   Ast.Print(s) -> Astc.Cout (Astc.CStrings [ Astc.CString (s) ] )
 | Ast.Expr (e) -> Astc.CExpr (cexpr_of_expr e)


(* 
function cstmt_of_answer_block - convert Ast.answer_block to 
   Astc.cstmt
*)
let rec cstmt_of_answer_block ab t = match ab with
    Ast.Block (sl) -> ignore (validate_statements sl t); 
	   ((List.map cstmt_of_statement sl) @ [Astc.BreakAll] )
   | Ast.AnswBlock (sl, q) ->  ignore (validate_statements sl t);
       ((List.map cstmt_of_statement sl) @ ([cstmt_of_question q]) @ [Astc.Break] ) 
   | Ast.Repeat (sl) -> ignore (validate_statements sl t);
       ((List.map cstmt_of_statement sl) @ [Astc.Continue]) 
(* 
function cstmt_of_question - convert Ast.question to 
   Astc.cstmt
*)
and cstmt_of_question = function
  (q, t, answers) -> check_types (t, answers); Astc.CWhile ( 
     Astc.CBlock [ Astc.Cout (Astc.CStrings [ Astc.CString  q ]); 
	 Astc.CIn t; cstmt_of_answer_list answers t] )
	 
(* function cstmt_of_answer - convert Ast.answer to Astc.cstmt*)
and cstmt_of_answer ans t = match ans with
    (e, ab) -> Astc.CIf ( 
	   cexpr_of_expr(e), (Astc.CBlock(cstmt_of_answer_block ab t)))	
(* function cstmt_of_answer_list - convert Ast.answer_list to Astc.cstmt*)	
and cstmt_of_answer_list answ t = (* function*) match answ with
    [] ->  Astc.Break
  | hd::tl -> Astc.CBlock [ cstmt_of_answer hd t; Astc.CElse (cstmt_of_answer_list tl t)]


(********************************************************************)


(* 
function cprogram_of_program
Top level conversion function that will be called from compile.ml,
converst from Ast.program to Astc.program
*)
let cprogram_of_program  = function
   (questions, statements, myenv) -> globalEnv.contents <- myenv; 
   ignore(validate_statements statements "out_of_scope"); 
   Astc.CBlock ( (List.map cstmt_of_question questions) @
   (List.map cstmt_of_statement statements))
